(in-package #:experiment)

(defstruct mouse
  x y state)

(defvar *mouse* nil)

(defun update-mouse-state (x y state)
  (unless *mouse*
    (setf *mouse* (make-mouse :x 0 :y 0 :state 0)))
  (setf (mouse-state *mouse*) state
        (mouse-x *mouse*) x
        (mouse-y *mouse*) y))

(defmacro make-event ((type) &body body)
  `(let ((event (sdl::new-event (intern (subseq (string ,type) 4) :keyword))))
     ,@body
     (sdl-cffi::sdl-push-event event)))

(defun push-key-event (type sym mods)
  ;; escape puts us in fullscreen mode and we want to avoid that when
  ;; replaying events.
  (unless (eq sym :sdl-key-escape)
    (make-event (type)
      (setf
       (cffi:foreign-slot-value (cffi:foreign-slot-pointer event
                                                           'sdl-cffi::sdl-keyboard-event
                                                           'sdl-cffi::keysym)
                                'sdl-cffi::sdl-key-sym 'sdl-cffi::sym) sym
       (cffi:foreign-slot-value (cffi:foreign-slot-pointer event
                                                           'sdl-cffi::sdl-keyboard-event
                                                           'sdl-cffi::keysym)
                                'sdl-cffi::sdl-key-sym 'sdl-cffi::mod) mods))))

(defun push-mouse-click-event (type button x y)
  (make-event (type)
    (update-mouse-state x y (if (eq type :sdl-mouse-button-down-event) 1 0))
    (setf (cffi:foreign-slot-value event 'sdl-cffi::Sdl-Mouse-Button-Event 'sdl-cffi::button) button
          (cffi:foreign-slot-value event 'sdl-cffi::Sdl-Mouse-Button-Event 'sdl-cffi::x) x
          (cffi:foreign-slot-value event 'sdl-cffi::Sdl-Mouse-Button-Event 'sdl-cffi::y) y)))

(defun push-mouse-motion-event (type state x y xrel yrel)
  (make-event (type)
    (update-mouse-state x y state)
    (setf 
     (cffi:foreign-slot-value event 'sdl-cffi::SDL-Mouse-Motion-Event 'sdl-cffi::state) state
     (cffi:foreign-slot-value event 'sdl-cffi::SDL-Mouse-Motion-Event 'sdl-cffi::x) x
     (cffi:foreign-slot-value event 'sdl-cffi::SDL-Mouse-Motion-Event 'sdl-cffi::y) y
     (cffi:foreign-slot-value event 'sdl-cffi::SDL-Mouse-Motion-Event 'sdl-cffi::xrel) xrel
     (cffi:foreign-slot-value event 'sdl-cffi::SDL-Mouse-Motion-Event 'sdl-cffi::yrel) yrel)))

(defun push-resize-event (type width height)
  (make-event (type)
    (setf (cffi:foreign-slot-value event 'sdl-cffi::Sdl-Resize-Event 'sdl-cffi::w) width
          (cffi:foreign-slot-value event 'sdl-cffi::Sdl-Resize-Event 'sdl-cffi::h) height)))

(defun push-timer-event (type &key delay repeat)
  (declare (ignore type repeat))
  (let ((tm (first gwee::*timer-list*)))
    (assert tm () "Timer event but no timers are present!")
    (assert (eql delay (gwee::timer-delay tm)) ()
            "Something funny with the timers. ~a ~a" delay (gwee::timer-delay tm))
    (assert (null (gwee::timer-repeat tm)) () "I can't handle repeat timers.")
    (apply (gwee::timer-function tm)
           (gwee::timer-args tm))
    (pop gwee::*timer-list*)
    (gwee::update-views)))

(defun push-unknown-event (type &rest keys)
  (print `(ignoring ,type ,@keys))
  ;; ignore
  nil
  )

(defun push-event (type &rest data)
  "Pushes a new `SDL_Event` of type `:SDL-USER-EVENT` onto the event queue."
  (apply 
   (case type
     ((:sdl-mouse-button-down-event :sdl-mouse-button-up-event)
      'push-mouse-click-event)
     ((:sdl-mouse-motion-event)
      'push-mouse-motion-event)
     ((:sdl-key-down-event :sdl-key-up-event)
      'push-key-event)
     (:sdl-video-resize-event
      'push-resize-event)
     (:timer-event
      'push-timer-event)
     (t 'push-unknown-event))
   type data))

(defvar *fps* 30)

(defvar *record-frame* nil)

(defstruct (record-frame (:conc-name rf-))
  pathname events (last-time 0) surface ffmpeg-file (pnum 0)
  states-of-interest
  last-frame-state
  compression)

(defstruct evdebug
  stream pnum state record-these)

(defvar *debug* nil)

(defun dprint (thing)
  (when *debug*
    (let ((*package* (find-package :exp)))
      (print `(,(get-internal-real-time) ,@thing) (evdebug-stream *debug*))
      (finish-output (evdebug-stream *debug*)))))

(defun debug-check-new-problem ()
  (when (and *debug*
             (not (eq (evdebug-state *debug*)
                      (type-of (current-state *experiment*)))))
    (incf (evdebug-pnum *debug*))
    (close (evdebug-stream *debug*))
    (setf (evdebug-stream *debug*) (open (format nil "~~/tmp/replay-debug/replay-debug-~2,'0d-~a.txt" (evdebug-pnum *debug*) (type-of (current-state *experiment*)))
                                       :direction :output
                                       :if-exists :supersede)
          (evdebug-state *debug*) (type-of (current-state *experiment*)))))

(defun reset-debug (record-these)
  (when *debug*
    (close (evdebug-stream *debug*)))
  (setf *debug* (make-evdebug
                 :stream (open "~/tmp/replay-debug/replay-debug.txt"
                               :direction :output
                               :if-exists :supersede)
                 :record-these record-these
                 :pnum 0
                 :state nil)))

(defvar *fake-event-hook* nil
  "Called when there a new event is faked.")

(defvar *now-cache* nil)

(defstruct now-cache
  (time 0) event frame)

;; (defun reset-now-cache ()
;;   (setf *now-cache* nil))

(defun replay-now ()
  ;;(print 'now)
  (let ((next-event (when (rf-events *record-frame*)
                      (caar (rf-events *record-frame*))))
        (next-frame (when (rf-last-time *record-frame*)
                      (+ (rf-last-time *record-frame*) (truncate 1000 *fps*)))))
    (if (and (eql (now-cache-event *now-cache*) next-event)
             (eql (now-cache-frame *now-cache*) next-frame))
        (progn
          ;;(dprint `(cache ,(now-cache-time *now-cache*)))
          (now-cache-time *now-cache*))
        (progn
          ;; ;; things mess up when they're the same
          ;; (when (and next-event
          ;;            next-timer
          ;;            (= next-event next-timer))
          ;;   (incf next-timer))
          (dprint `(start newnow))
          (setf (now-cache-event *now-cache*) next-event
                (now-cache-frame *now-cache*) next-frame)
          (setf (now-cache-time *now-cache*)
                (cond
                  ((<= next-event next-frame)
                   (dprint `(event ,next-event))
                   (1+ next-event))
                  ((<= next-frame next-event)
                   (dprint `(frame ,next-frame))
                   (1+ next-frame))
                  (t
                   (dprint `(nuthin))
                   (finish-output)
                   0)))
          (dprint `(newnow ,*now-cache*))
          (now-cache-time *now-cache*)))))

(defun replay-delay (ms)
  (declare (ignore ms))
  ;; we don't delay
  ;; (dprint `(delay ,ms ,*now-cache*))
  )

(defun timer-hook ()
  (dprint `(timer expired))
  (setf *now-cache* nil))

(defun install-replay-functions ()
  (setf (symbol-function 'gwee::now) #'replay-now
        (symbol-function 'gwee::delay) #'replay-delay
        (symbol-function 'gwee::clear-event-queue) (lambda (&optional sleep) (declare (ignore sleep)))
        gwee::*tick-hook* 'record-frame
        gwee::*fake-event-hook* 'fake-event
        gwee::*expired-timers-function* (lambda ())))

(defun uninstall-replay-functions ()
  (setf (symbol-function 'gwee::now) #'get-internal-real-time
        (symbol-function 'gwee::delay) #'sdl-cffi::sdl-delay
        gwee::*tick-hook* nil
        gwee::*fake-event-hook* nil
        gwee::*expired-timers-function* nil))

;;; Splitting event files

(defstruct replay-session
  file name id options events)

(defun read-event-file (file)
  (let ((events (u:slurp-lisp-file file (find-package :exp))))
    (assert (eq (caar events) 'experiment)
            () "An experiment line must be first in the event file ~a" file)
    (loop for e in events
          with session = nil
          with sessions = nil
          when (eq (first e) 'experiment)
            do (when session
                 (setf sessions (nconc sessions (list session))))
               (setf session (make-replay-session :name (getf (cdr e) :session)
                                                  :file file
                                                  :id (getf (cdr e) :id)
                                                  :options (getf (cdr e) :options)))
          else
            do (setf (replay-session-events session) (nconc (replay-session-events session)
                                                            (list e)))
          finally (return (nconc sessions (list session))))))

(defun stitch-resume-sessions (sessions)
  ;; FIXME: this might not actually work because there will be problem
  ;; overlap and the events will get all out of sync.
  (loop for last = (first sessions) then s
        for s in (cdr sessions)
        when (eq (replay-session-name s) :resume)
          do (setf (replay-session-events last)
                   (append (replay-session-events last)
                           (replay-session-events s))))
  (remove :resume sessions :key 'replay-session-name))

(defun prompt-for-session (sessions)
  (gwee:with-layout
      (:views
       (ultrafast gwee:radio-button :data "Fast Compression" :radio-id :compression)
       (max gwee:radio-button :data "Slow Compression" :selected t :radio-id :compression)
       (choose gwee:text-area :data "Choose a session"))
      (:layouts
       (column gwee:column-layout
               (choose ultrafast max)
               :padding 10
               :width 200
               :height :minimum
               :x :center
               :y :center)
       ;; (compression gwee:row-layout
       ;;              (ultrafast uf-text max max-text)
       ;;              :width :minimum :height :minimum)
       )
      (:parent gwee:*top-view*
       :delete-p nil)
    (mapc (lambda (s)
            (make-instance 'gwee:button
                           :parent column
                           :data (replay-session-name s)
                           :click-callback (lambda (b)
                                             (gwee:delete-view (gwee:view-parent b))
                                             (return-from prompt-for-session (values s
                                                                                     (if (gwee:selected ultrafast)
                                                                                         :ultrafast
                                                                                         :max))))))
          sessions)
    (sdl:clear-display (gwee:gray 0) :surface sdl:*default-surface*)
    (gwee:dispatch-events)))

(defun count-states (state)
  (if (typep state 'subsequence)
      (1+ (reduce '+ (subsequence-children state) :key 'count-states))
      1))

(defun replay-events-from-session (session experiment-sessions &key options-callback of-interest dry-run record-these (compression :max))
  "Run this in its own thread."
  (declare (ignorable record-these))
  ;;(reset-debug record-these)
  (setf *record-frame* (make-record-frame
                        :compression compression
                        :states-of-interest (if dry-run
                                                nil
                                                of-interest)
                        :pathname (make-pathname :defaults (replay-session-file session)
                                                 ;; The assumption is that the event file is from the log/ folder
                                                 :directory (append (butlast (pathname-directory (replay-session-file session)))
                                                                    (list "videos"))
                                                 :name (format nil "~a-s~a" (replay-session-id session) (1+ (position (replay-session-name session) experiment-sessions
                                                                                                                     :key 'first :test 'equal)))
                                                 :type "mp4")
                        :events (replay-session-events session))
        *now-cache* (make-now-cache))
  (ensure-directories-exist (rf-pathname *record-frame*))

  (let ((progress (make-instance 'gwee:text-area
                                 :border-color (gwee:gray 0)
                                 :background (gwee:gray 255)
                                 :foreground (gwee:gray 0)
                                 :parent gwee:*top-view*
                                 :x :center :y :center
                                 :horizontal-justification :center
                                 :margin 10
                                 :width 400 :height :minimum
                                 :data "0 of 0 done (0%)"))
        (num-events (length (replay-session-events session)))
        (old-top gwee:*top-view*))
    (sdl:clear-display (gwee:gray 0) :surface sdl:*default-display*)
    (gwee::update-views)
    (unwind-protect
         (labels ((update-progress (rf)
                    (let ((gwee:*top-view* old-top)
                          (sdl:*default-surface* sdl:*default-display*))
                      (setf (gwee:view-data progress) (format nil "~d of ~d done (~d%)"
                                                              (- num-events (length (rf-events rf))) num-events
                                                              (- 100 (truncate (* (/ (length (rf-events rf)) num-events) 100))))
                            (gwee:view-needs-update-p progress) t)
                      (gwee::update-views))))
           (let ((gwee:*top-view* (make-instance 'gwee::top
                                                 :width (gwee:view-width gwee:*top-view*)
                                                 :height (gwee:view-height gwee:*top-view*)))
                 (*skip-log-file* t)
                 (*fake-event-hook* #'update-progress))
             (sdl:with-surface (new-surface #|gwee:*surface*|# (sdl:convert-to-display-format :surface sdl:*default-display*))
               (sdl:clear-display (gwee:gray 0) :surface sdl:*default-surface*)
               (install-replay-functions)
               (unwind-protect
                    (experiment-main-loop :options (loop for rest = (replay-session-options session) then (cddr rest)
                                                         while rest
                                                         for name = (first rest)
                                                         for value = (second rest)
                                                         collect (make-instance 'option
                                                                                :name name
                                                                                :initial-value value
                                                                                :value value))
                                          :options-callback options-callback
                                          :id (replay-session-id session)
                                          :session (replay-session-name session)
                                          :sessions experiment-sessions)
                 (when (rf-ffmpeg-file *record-frame*)
                   (sdl-ffmpeg:finish-video (rf-ffmpeg-file *record-frame*))
                   (setf (rf-ffmpeg-file *record-frame*) nil))
                 (uninstall-replay-functions)))))
      (gwee:delete-view progress)
      (sdl:clear-display (gwee:gray 0) :surface sdl:*default-display*))))

(defun replay-events-from-file (id template experiment-sessions lastp &key options-callback of-interest dry-run)
  (let* ((file (get-event-file id template))
         (sessions (read-event-file file))
         session compression)
    (if lastp
        (setf session (u:last1 sessions)
              compression :ultrafast)
        (multiple-value-setq (session compression)
          (prompt-for-session sessions)))
    (replay-events-from-session session experiment-sessions
                                :options-callback options-callback
                                :of-interest of-interest
                                :dry-run dry-run
                                :compression compression)))

(defun set-random-seed (seed)
  (setf mt19937:*random-state* (mt19937:init-random-state seed)))

(defun draw-mouse (surface)
  ;; FIXME: make it translucent for extra points!
  (when *mouse*
    (let ((points (list (sdl:point :x (mouse-x *mouse*)
                                   :y (mouse-y *mouse*))
                        (sdl:point :x (+ (mouse-x *mouse*) 16)
                                   :y (+ (mouse-y *mouse*) 20))
                        (sdl:point :x (+ (mouse-x *mouse*) 8)
                                   :y (+ (mouse-y *mouse*) 20))
                        (sdl:point :x (mouse-x *mouse*)
                                   :y (+ (mouse-y *mouse*) 25)))))
      (sdl:draw-filled-polygon points
                               :color (if (plusp (mouse-state *mouse*))
                                          (gwee:color 255 0 0)
                                          (gwee:gray 0))
                               :surface surface)
      (sdl:draw-aa-polygon points :color (gwee:gray 255)
                                  :surface surface))))

(defun fake-event (time &optional (rf *record-frame*))
  (when (rf-events rf)
    (let ((next-event (>= time
                          (caar (rf-events rf)))))
      (when next-event
        (let ((data (cdr (pop (rf-events rf)))))
          ;;(reset-now-cache)
          ;;(print `(event ,(car (rf-events rf))))
          (finish-output)
          (apply 'push-event
                 (intern (symbol-name (first data)) :keyword)
                 (cdr data))
          (when *fake-event-hook*
            (funcall *fake-event-hook* rf)))))
    (unless (rf-events rf)
      (when (rf-ffmpeg-file rf)
        (sdl-ffmpeg:finish-video (rf-ffmpeg-file rf))
        (setf (rf-ffmpeg-file rf) nil))
      (uninstall-replay-functions)
      (throw 'restart nil))))

(defun record-movie (filename compression)
  ;; libx264 doesn't work on G3 PPCs so use FFV1 instead.
  (let ((file (sdl-ffmpeg:init-video filename (gwee:view-width gwee:*top-view*) (gwee:view-height gwee:*top-view*) *fps*
                                     :bitrate 5000
                                     :codec 28 ;; 28 = h264 ;; 34 = FFV1
                                     :options (ecase compression
                                                (:max sdl-ffmpeg::*x264-lossless-max*)
                                                (:ultrafast sdl-ffmpeg::*x264-lossless-ultrafast*)))))
    (print (multiple-value-list (sdl-ffmpeg::get-video-size file)))
    file))

(defun record-frame (time &key (rf *record-frame*))
  ;;(reset-now-cache)
  ;; fill missing slots
  (when (null (rf-surface rf))
    (setf (rf-surface rf) (sdl:create-surface (gwee:view-width gwee:*top-view*) (gwee:view-height gwee:*top-view*))))
  (when (>= (- time (rf-last-time rf)) (truncate 1000 *fps*))
    (dprint `(record))
    (setf (rf-last-time rf) time)
    (if (find (type-of (current-state *experiment*))
              (rf-states-of-interest rf))
        (progn
          ;; detect when we've switched to a new state.
          (when (and (rf-ffmpeg-file rf)
                     (not (eq (rf-last-frame-state rf) (current-state *experiment*))))
            (sdl-ffmpeg:finish-video (rf-ffmpeg-file rf))
            (setf (rf-ffmpeg-file rf) nil))
          (unless (rf-ffmpeg-file rf)
            (incf (rf-pnum rf))
            (dprint `(new problem ,(rf-pnum rf)))
            (setf (rf-ffmpeg-file rf)
                  (record-movie (namestring (make-pathname :name (format nil "~a-p~2,'0d"
                                                                         (pathname-name (rf-pathname rf))
                                                                         (rf-pnum rf))
                                                           :defaults (rf-pathname rf)))
                                (rf-compression rf))))
          (dprint `(frame ,time))
          (sdl:blit-surface sdl:*default-surface* (rf-surface rf))
          (draw-mouse (rf-surface rf))
          (sdl-ffmpeg:save-video-frame (rf-ffmpeg-file rf) (rf-surface rf))
          (setf (rf-last-frame-state rf) (current-state *experiment*)))
        (progn
          (when (rf-ffmpeg-file rf)
            ;; pad the end of the video
            ;; (dotimes (i 10)
            ;;   (sdl-ffmpeg:save-video-frame (rf-ffmpeg-file rf) (rf-surface rf)))
            (sdl-ffmpeg:finish-video (rf-ffmpeg-file rf))
            (setf (rf-ffmpeg-file rf) nil))))))
